home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / rotate2 / rotate.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1994-11-13  |  10.5 KB  |  353 lines
  1. PROGRAM Rotate_A_BitMap____VERY_SLOWLY___but_with_scaling;
  2.  
  3. {
  4.  Written by John Paul D'India (from D'India Software)
  5.  
  6.   Since I'm writing this, I'm gonna have to suggest you guys go out and
  7.   download DARKWOLF.  Here's my little ad =)
  8.  
  9.     ╔════════════════════════╡ D'India Software ╞═══════════════════════╗
  10.     ║  ▀▄▄▄▄▄▄▄▄               ▄         ▄                          ▄▄  ║
  11.     ║     █     ▀▀▄             ▀▄        █              ▄        ▄▀  ▀ ║
  12.     ║     █        ▀▄            █         █            █      █  █     ║
  13.     ║     █         █            █   ▄     ▀▄           █      █  █     ║
  14.     ║     █         █  ▄▄▄  █▄▀▄ █▄▄▀       █          █  ▄▄▄  █ ▄█▄▄   ║
  15.     ║     █       ▄▀ ▄▀   █ █    █  ▀▄       █    ▄    █ █   █ █  █     ║
  16.     ║     ▀    ▄▄▀   █    █ █    █   █       ▀▄  █ ▀▄  █ █   █ █  █     ║
  17.     ║     ▄▄▀▀▀       ▀▀▀▀▀ ▀   ▄▀   ▀▄       ▀▄ █  ▀▄ █  ▀▀▀  ▀  █     ║
  18.     ║  ▀▀▀                                      ▀     ▀           ▀     ║
  19.     ╠═══════════════════════════════════════════════════════════════════╣
  20.     ║ D'India Software's latest SHAREWARE masterpiece!  DARKWOLF, the   ║
  21.     ║ action game with awesome 256 color VGA graphics, digital sound,   ║
  22.     ║ digital music, 32-bit parallax scrolling, and more!  The "play    ║
  23.     ║ control" and "fun factor" are impressive!  As the king's wizard,  ║
  24.     ║ you must try and keep the kingdom from being thrown into civil    ║
  25.     ║ war, but beware Grondahl Morrison is out to shorten your lifespan.║
  26.     ║                           CHECK IT OUT!!                          ║
  27.     ╚═══════════════════════════════════════════════════════════════════╝
  28.  
  29.  
  30.  This program demonstrates simple rotation in PASCAL!
  31.  It first calculates the four corners of the bitmap.
  32.  
  33.              P1
  34.               ■
  35.              /  \
  36.            /      \
  37.          /          \
  38.     P3 ■             ■ P2
  39.         \          /
  40.           \      /
  41.             \  /
  42.              ■
  43.             P4
  44.  
  45.  Then, going down from P1 to P3 the program draws lines with a P1-P2 slope.
  46.  It indexes into the bitmap to find the proper color.
  47.  
  48.  Things could be GREATLY speeded up by replacing
  49.   - PutPixel ( X,Y,Mem[Seg(Buf):Ofs(Buf)+(BitMap_Pos * W) div BitMap_Dif] );
  50.  with a faster method.
  51.  
  52.  One suggestion is to simply change the inner line loop as follows
  53.       PutPixel ( X,Y,Mem[Seg(Buf):Ofs(Buf)+BitMap_Pos] );
  54.       for x:=x1+1 to x2 do
  55.         begin
  56.           if ( d >= 0 ) then
  57.             begin
  58.               PutPixel ( X,Y,Mem[Seg(Buf):Ofs(Buf)+BitMap_Pos] );
  59.               inc( y, yincr );
  60.               inc( d, aincr );
  61.             end
  62.           else
  63.               inc( d, bincr );
  64.         Inc ( BitMap_Pos,BitMap_Dir );
  65.         PutPixel ( X,Y,Mem[Seg(Buf):Ofs(Buf)+BitMap_Pos] );
  66.         end;
  67.   This should give you descent accuracy, and it will make the procedure way
  68.   faster.  You also have to initialize BitMap_Pos to W and not BitMap_Dif!
  69.  
  70.   The important thing to remember is that there are many different techniques
  71.   to drawing a line.  This is just one (slow) approach.  However please
  72.   remember it is still way faster than rotating each point individually, AND
  73.   it DOES scale!
  74.  
  75. }
  76.  
  77. Const
  78.   Sine_Cosine_Precision = 128;
  79.   Max_Size              = 140;
  80.   Min_Size              = 20;
  81.  
  82.  
  83. Var Angle         : Integer;
  84.     Cosine        : Array[0..359] of Integer;
  85.     Sine          : Array[0..359] of Integer;
  86.     BitMap_Width  : Word;
  87.     BitMap_Heigth : Word;
  88.     BitMap        : Pointer;
  89.     F             : File;
  90.     RGB           : Array[1..768] of Byte;
  91.     Scr           : Pointer;
  92.  
  93.     Size          : Integer;
  94.     SizeDir       : Integer;
  95.  
  96.  
  97. {────────────────────────────────────────────────────────────────────────────}
  98.  
  99.  
  100. PROCEDURE PutPixel ( X,Y,Col : Integer );
  101. BEGIN
  102. Mem[Seg(Scr^):Ofs(Scr^)+Y*320+X] := Col;
  103. END;
  104.  
  105.  
  106. {────────────────────────────────────────────────────────────────────────────}
  107.  
  108.  
  109. PROCEDURE Line_Copy ( Var Buf;W,X1,Y1,X2,Y2 : Integer );
  110.  
  111. var d, dx, dy,
  112.     aincr, bincr,
  113.     xincr, yincr,
  114.     x, y                 : integer;
  115.     BitMap_Pos           : Integer;
  116.     BitMap_Dir           : Integer;
  117.     BitMap_Dif           : Integer;
  118.  
  119.  
  120. procedure SwapInt( var i1, i2: integer );
  121. var dummy : integer;
  122. begin
  123.   dummy := i2;
  124.   i2    := i1;
  125.   i1    := dummy;
  126. end;
  127.  
  128.  
  129. begin
  130.   if ( abs(x2-x1) < abs(y2-y1) ) then
  131.     begin
  132.       BitMap_Dif := abs(x2-X1)+abs(y2-y1);
  133.       if ( y1 > y2 ) then
  134.         begin
  135.           SwapInt( x1, x2 );
  136.           SwapInt( y1, y2 );
  137.           BitMap_Dir := -1;
  138.           BitMap_Pos := BitMap_Dif;
  139.         end else
  140.          BEGIN
  141.           BitMap_Dir := 1;
  142.           BitMap_Pos := 0;
  143.          END;
  144.  
  145.       if ( x2 > x1 ) then xincr := 1
  146.                      else xincr := -1;
  147.  
  148.       dy := y2 - y1;
  149.       dx := abs( x2-x1 );
  150.       d  := 2 * dx - dy;
  151.       aincr := 2 * (dx - dy);
  152.       bincr := 2 * dx;
  153.       x := x1;
  154.       y := y1;
  155.  
  156.       PutPixel ( X,Y,Mem[Seg(Buf):Ofs(Buf)+(BitMap_Pos * W) div BitMap_Dif] );
  157.       for y:=y1+1 to y2 do                   { Execute line on Y-axes }
  158.         begin
  159.           if ( d >= 0 ) then
  160.             begin
  161.               Inc ( BitMap_Pos,BitMap_Dir );
  162.               PutPixel ( X,Y,Mem[Seg(Buf):Ofs(Buf)+(BitMap_Pos * W) div BitMap_Dif] );
  163.               inc( x, xincr );
  164.               inc( d, aincr );
  165.             end
  166.           else
  167.             inc( d, bincr );
  168.         Inc ( BitMap_Pos,BitMap_Dir );
  169.         PutPixel ( X,Y,Mem[Seg(Buf):Ofs(Buf)+(BitMap_Pos * W) div BitMap_Dif] );
  170.         end;
  171.     end
  172.   else                                                 { Check X-axes }
  173.     begin
  174.       BitMap_Dif := abs(x2-X1)+abs(y2-y1);
  175.       if ( x1 > x2 ) then                                  { x1 > x2? }
  176.         begin
  177.           SwapInt( x1, x2 );                { Yes --> Swap X1 with X2 }
  178.           SwapInt( y1, y2 );                {         and Y1 with Y2  }
  179.           BitMap_Dir := -1;
  180.           BitMap_Pos := BitMap_Dif;
  181.         end else
  182.          BEGIN
  183.           BitMap_Dir := 1;
  184.           BitMap_Pos := 0;
  185.          END;
  186.  
  187.       if ( y2 > y1 ) then yincr := 1           { Set Y-axis increment }
  188.                      else yincr := -1;
  189.  
  190.       dx := x2 - x1;
  191.       dy := abs( y2-y1 );
  192.       d  := 2 * dy - dx;
  193.       aincr := 2 * (dy - dx);
  194.       bincr := 2 * dy;
  195.       x := x1;
  196.       y := y1;
  197.  
  198.       PutPixel ( X,Y,Mem[Seg(Buf):Ofs(Buf)+(BitMap_Pos * W) div BitMap_Dif] );
  199.       for x:=x1+1 to x2 do                   { Execute line on X-axes }
  200.         begin
  201.           if ( d >= 0 ) then
  202.             begin
  203.               Inc ( BitMap_Pos,BitMap_Dir );
  204.               PutPixel ( X,Y,Mem[Seg(Buf):Ofs(Buf)+(BitMap_Pos * W) div BitMap_Dif] );
  205.               inc( y, yincr );
  206.               inc( d, aincr );
  207.             end
  208.           else
  209.               inc( d, bincr );
  210.         Inc ( BitMap_Pos,BitMap_Dir );
  211.         PutPixel ( X,Y,Mem[Seg(Buf):Ofs(Buf)+(BitMap_Pos * W) div BitMap_Dif] );
  212.         end;
  213.  
  214. end;
  215.  
  216. END;
  217.  
  218.  
  219. {────────────────────────────────────────────────────────────────────────────}
  220.  
  221.  
  222. PROCEDURE Rotate ( Var Buf;OldW,OldH,W,H,X,Y,Angle : Integer );
  223. Var X1,Y1,X2,Y2,X3,Y3,X4,Y4 : Integer;
  224.     HalfH,HalfW             : Integer;
  225.     DeltaX,DeltaY           : Integer;
  226.     TY                      : Integer;
  227. BEGIN
  228. {
  229.   P1(X1,Y1)           P2(X2,Y2)
  230.     ■                   ■
  231.  
  232.  
  233.  
  234.     ■                   ■
  235.   P3(X3,Y3)           P4(X4,Y4)
  236.  
  237. }
  238. HalfH := H Shr 1;
  239. HalfW := W Shr 1;
  240. X1 := X+((-HalfW*Cosine[Angle])-(+HalfH*Sine[Angle])) DIV Sine_Cosine_Precision;
  241. X2 := X+((+HalfW*Cosine[Angle])-(+HalfH*Sine[Angle])) DIV Sine_Cosine_Precision;
  242. X3 := X+((-HalfW*Cosine[Angle])-(-HalfH*Sine[Angle])) DIV Sine_Cosine_Precision;
  243. X4 := X+((+HalfW*Cosine[Angle])-(-HalfH*Sine[Angle])) DIV Sine_Cosine_Precision;
  244.  
  245. Y1 := Y+((-HalfW*Sine[Angle])+(+HalfH*Cosine[Angle])) DIV Sine_Cosine_Precision;
  246. Y2 := Y+((+HalfW*Sine[Angle])+(+HalfH*Cosine[Angle])) DIV Sine_Cosine_Precision;
  247. Y3 := Y+((-HalfW*Sine[Angle])+(-HalfH*Cosine[Angle])) DIV Sine_Cosine_Precision;
  248. Y4 := Y+((+HalfW*Sine[Angle])+(-HalfH*Cosine[Angle])) DIV Sine_Cosine_Precision;
  249.  
  250. DeltaY := Y3-Y1;
  251. DeltaX := X3-X1;                {              ■ P1(X1,Y1)       }
  252. For TY := 0 to pred(H) do       {            /                   }
  253.  BEGIN                          {          /                     }
  254.                                 {        /                       }
  255.  X := DeltaX*TY Div H;          {      ■ P3(X3,Y3)               }
  256.  Y := DeltaY*TY Div H;          {   SubX := DeltaX*TY div H      }
  257.                                 {   SubY := DeltaY*TY div H      }
  258.  Line_Copy ( Mem[Seg(Buf):Ofs(Buf)+(TY*OldH div H)*OldW],OldW,X2+X,Y2+Y,X1+X,Y1+Y );
  259.  END;
  260. END;
  261.  
  262.  
  263. {────────────────────────────────────────────────────────────────────────────}
  264.  
  265.  
  266. PROCEDURE Make_Sine_Cosine_Table;
  267. Var I : Integer;
  268. BEGIN
  269. For I := 0 to 359 do
  270.   BEGIN
  271.   Sine[I]   := Round(Sin(I*3.14159265/180)*Sine_Cosine_Precision);
  272.   Cosine[I] := Round(Cos(I*3.14159265/180)*Sine_Cosine_Precision);
  273.   END;
  274. END;
  275.  
  276.  
  277. {────────────────────────────────────────────────────────────────────────────}
  278.  
  279.  
  280. PROCEDURE SETRGBBLOCK ( C,CNT : WORD;VAR BUF  ); ASSEMBLER;
  281. ASM
  282. PUSH DS
  283. CLD
  284. LDS  SI,BUF        { LOAD BUF INTO DS:SI }
  285. MOV  CX,CNT        { GET NUMBER OF COLORS TO SET }
  286. MOV  AX,3          { MULTIPLY BY 3 FOR R,G,B }
  287. MUL  CX
  288. MOV  CX,AX         { STORE IN COUNT REG }
  289. MOV  DX,3C8H       { PEL WRITE MODE }
  290. MOV  AX,C
  291. OUT  DX,AL         { WRITE COLOR NUMBER TO DAC }
  292.  
  293. INC  DX
  294. JCXZ @SKIP
  295. REP  OUTSB
  296. @SKIP:
  297.  
  298. POP  DS
  299. END;
  300.  
  301.  
  302. {────────────────────────────────────────────────────────────────────────────}
  303.  
  304.  
  305. BEGIN
  306. Asm
  307. Mov  AX,13h
  308. Int  10h
  309. End;
  310.  
  311. Assign ( F,'D''India.Cel' );
  312. Reset  ( F,1 );
  313. Seek   ( F,2 );
  314. Blockread ( F,BitMap_Width,2 );
  315. Blockread ( F,BitMap_Heigth,2 );
  316. Seek   ( F,32 );
  317. Blockread ( F,RGB,Sizeof(RGB) );
  318. RGB[255*3+2] := 42;
  319. RGB[255*3+1] := 0;
  320. RGB[255*3+0] := 0;
  321. SetRGBBlock ( 0,256,RGB );
  322. Getmem ( BitMap,BitMap_Heigth*BitMap_Width );
  323. Blockread ( F,BitMap^,BitMap_Heigth*BitMap_Width );
  324. Close  ( F );
  325.  
  326. Make_Sine_Cosine_Table;
  327.  
  328. GetMem ( Scr,64000 );
  329.  
  330. Angle := 0;
  331. Size := Min_Size;
  332. SizeDir := 1;
  333. Repeat
  334. Angle := (Angle+4) MOD 360;
  335. Fillchar ( Scr^,64000,0 );
  336. Inc ( Size,SizeDir );
  337. If Size > Max_Size then SizeDir := -SizeDir else
  338. If Size < Min_Size then SizeDir := -SizeDir;
  339. Rotate ( BitMap^,BitMap_Width,BitMap_Heigth,
  340.          BitMap_Width*Size div 100,
  341.          BitMap_Heigth*Size div 100,
  342.          160,100,
  343.          Angle );
  344. Move ( Scr^,Mem[$A000:$0000],64000 );
  345. Until Port[$60] = 129;
  346.  
  347. FreeMem ( Scr,64000 );
  348.  
  349. Asm
  350. Mov  AX,03h
  351. Int  10h
  352. End;
  353. END.